home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / printing / ljetmgr2.4-b / ljetmgr2 / SW / lib / libsetup1.3.tsl < prev    next >
Text File  |  1996-06-05  |  14KB  |  293 lines
  1. # RQ txField 5
  2. # RQ txStdBox 5
  3. # RQ txText 5
  4. # RQ txScroller 5
  5. # RQ bltbusy 1.9
  6. # RQ tixPanedWindow 4
  7. # RQ tixTree 4
  8. # RQ txHelp 2
  9. # RQ config 10
  10. # RQ txError 1
  11. # RQ msg 2
  12. # RQ txFrame 5
  13. # RQ txDlgShell 5
  14. # RQ tclx 7.5
  15. # RQ tclkit 3
  16. # +END
  17. # RCS:    $Id: widget.tcl,v 1.1.1.1 1996/05/12 14:46:18 risc Exp $
  18. proc setup_Init { args } {Require msg 2
  19. Require config 10
  20. catch {ConfigRead [Locate msg setup] "Msg def"}}
  21. Require txScroller 5
  22. tixWidgetClass txCfg {-classname TxCfg
  23. -superclass txScroller
  24. -method {addgroup
  25. additem
  26. showitem
  27. clearitem
  28. delgroup
  29. delitem
  30. hideitems
  31. blink}
  32. -flag {-showcmd
  33. -editcmd
  34. -validatecmd
  35. -savecmd
  36. -loadcmd
  37. -printcmd
  38. -exitcmd
  39. -helpcmd}
  40. -configspec {{-state state State normal}
  41. {-modified modified Modified 0}      
  42. {-labelside labelside Labelside top}            
  43. {-wrap wrap Wrap none}                  
  44. {-width width Width 80}                  
  45. {-height height Height 24}                        
  46. {-font font Font {}}
  47. {-editcmd editcmd Editcmd {}}
  48. {-validatecmd validatecmd Validatecmd {}}
  49. {-showcmd showcmd Showcmd {}}
  50. {-savecmd savecmd Savecmd {}}
  51. {-loadcmd loadcmd Loadcmd {}}
  52. {-exitcmd exitcmd Exitcmd {}}
  53. {-helpcmd helpcmd Helpcmd {}}
  54. {-scrollbar scrollbar Scrollbar none}
  55. {-express express Express 1}    
  56. {-labelside labelside Labelside top}
  57. {-help help Help "Config"}}}
  58. proc txCfg::ConstructWidget { w } {upvar #0 $w data
  59. set data(group) ""
  60. set data(item) ""
  61. set data(format) "s"
  62. tixChainMethod $w ConstructWidget
  63. set fbox $data(pw:scroll)
  64. Require tixPanedWindow 4
  65. set fb [tixPanedWindow $fbox.pane -orientation horizontal -relief sunken ]
  66. set p1 [$fbox.pane add tree -min 70 -size [Cfg def txCfg TreeWidth 180 -format {i 70 550}] -max 550 ]
  67. set p2 [$fbox.pane add list -min 70 ]
  68. Require tixTree 4
  69. tixTree $p1.tree -browsecmd "txCfg::ShowCmd $w"
  70. set data(w:tree) $p1.tree
  71. set data(w:hlist) [$p1.tree subwidget hlist]
  72. $data(w:hlist) config -separator .
  73. pack $p1.tree -padx 5 -pady 5 -fill both -expand y
  74. Require txFrame 5
  75. set b $w
  76. Require msg 2
  77. Require tclkit 3
  78. set l [$b add left load -text [Msg def txCfg LoadL "Load"] -underline [Msg def txCfg LoadU 0] -image [LocateImage bitmap [Msg def txCfg LoadI ""]] -command "txCfg::Do loadcmd $w" ]
  79. set s [$b add left save -text [Msg def txCfg SaveL "Save"] -underline [Msg def txCfg SaveU 0] -image [LocateImage bitmap [Msg def txCfg SaveI ""]] -command "txCfg::Do savecmd $w" ]
  80. set p [$b add left print -state disabled -text [Msg def txCfg PrintL "Print"] -underline [Msg def txCfg PrintU 0] -image [LocateImage bitmap [Msg def txCfg PrintI ""]] -command "txCfg::Do printcmd $w" ]
  81. set e [$b add right exit -text [Msg def txCfg ExitL "Exit"] -underline [Msg def txCfg ExitU 0] -image [LocateImage bitmap [Msg def txCfg ExitI ""]] -command "txCfg::Do exitcmd $w" ]
  82. set h [$b add right help -text [Msg def txCfg HelpL "Help"] -underline [Msg def txCfg HelpU 0] -image [LocateImage bitmap [Msg def txCfg HelpI ""]] -command "Require txHelp 2;txHelpRef $w $b" ]
  83. Require txField 5
  84. set data(w:name) [txField $p2.name -label [Msg def txCfg Name "Name"] -labelside top -state view ]
  85. Require txText 5
  86. set data(w:doc) [txText $p2.doc -state view -wrap word -labelside top -label [Msg def txCfg Doc "Documentation"] -width [Cfg def txCfg DocWidth 40] -height [Cfg def txCfg DocHeight 4] ]
  87. set data(w:default) [txField $p2.default -label [Msg def txCfg Default "Default"] -labelside top -state view ]
  88. set data(w:current) [txField $p2.current -label [Msg def txCfg Current "Current"] -labelside top -command "txCfg::Edit $w change" -validatecommand $data(-validatecmd) -validate none ]
  89. Require txStdBox 5
  90. txStdBox $p2.box -typ okcan -helpcmd "Require txHelp 2;txHelpRef $w $p2.box" -okcmd "txCfg::Edit $w change" -cancelcmd "txCfg::Edit $w default"
  91. [$p2.box subwidget ok] configure -text [Msg def txCfg ChangeL "Change"] -underline [Msg def txCfg ChangeU 0]
  92. [$p2.box subwidget cancel] configure -text [Msg def txCfg DefaultL "Default"] -underline [Msg def txCfg DefaultU 0]
  93. pack $data(w:name) -padx 5 -pady 3 -fill x
  94. pack $data(w:doc) -padx 5 -pady 3 -fill both -expand y
  95. pack $data(w:default) -padx 5 -pady 3 -fill x
  96. pack $data(w:current) -padx 5 -pady 3 -fill x
  97. pack $p2.box -padx 5 -pady 3 -fill x
  98. grid $fbox.pane -column 0 -row 1 -padx 5 -pady 5 -sticky news
  99. grid columnconfigure $data(pw:scroll) 0 -weight 100
  100. grid rowconfigure $data(pw:scroll) 1 -weight 100}
  101. proc txCfg::addgroup { w id label } {upvar \#0 $w data
  102. $data(w:hlist) add $id -text "\[$label\]" -data "$label"
  103. $data(w:tree) setmode $id none}
  104. proc txCfg::additem { w parent id label } {upvar \#0 $w data
  105. $data(w:hlist) add $parent.$id -text "$label"
  106. $data(w:tree) setmode $parent close}
  107. proc txCfg::showitem { w group item default current doc {valid "s"}} {upvar \#0 $w data
  108. $data(w:name) set "\[$group\]:$item"
  109. $data(w:default) set $default
  110. $data(w:current) set $current
  111. $data(w:doc) set $doc
  112. set data(format) $valid
  113. $data(w:current) config -validatecommand "txCfg::Validate $w %P [list $valid]" -validate none}
  114. proc txCfg::clearitem { w } {upvar \#0 $w data
  115. $data(w:name) set ""
  116. $data(w:default) set ""
  117. $data(w:current) set ""
  118. $data(w:doc) set ""
  119. set data(format) ""
  120. set data(group) ""
  121. set data(item) ""
  122. $data(w:current) config -validatecommand {}}
  123. proc txCfg::delgroup { w id } {upvar \#0 $w data
  124. $data(w:hlist) delete entry $id}
  125. proc txCfg::delitem { w parent id } {upvar \#0 $w data
  126. $data(w:hlist) delete entry $parent.$id}
  127. proc txCfg::hideitems { w parent } {upvar \#0 $w data
  128. set children [$data(w:hlist) info children $parent]
  129. foreach i $children {$data(w:hlist) hide entry $i}
  130. $data(w:tree) setmode $parent open}
  131. proc txCfg::blink { w } {upvar \#0 $w data
  132. set e [$data(w:current) subwidget entry]
  133. $e selection clear
  134. $e selection range 0 end
  135. after 200 $e selection clear
  136. after 400 $e selection range 0 end
  137. after 600 $e selection clear}
  138. proc txCfg::ShowCmd { w path } {set item {}
  139. lset [split $path "."] group item
  140. if { $item=={} } {return}
  141. upvar \#0 $w data
  142. set data(group) $group
  143. set data(item) $item
  144. if { $data(-showcmd)!="" } {set cmd [Replace $data(-showcmd) [list %w=$w %p=$path %g=$group %i=$item %h=$data(w:hlist) %t=$data(w:tree) %G=[$data(w:hlist) info data $group] %I=[$data(w:hlist) item cget $path 0 -text] ]]
  145. eval $cmd}
  146. return}   
  147. proc txCfg::Validate { w new format} {switch [lindex $format 0] {"s" {set ret 1}
  148. "i" -
  149. "int" {set ret 1
  150. if { [regexp {^[+-]?[0-9]+$} $new] } {lset -create $format dummy lo hi
  151. if { ($lo!="") && ($lo>$new) } {set ret 0}
  152. if { ($hi!="") && ($hi<$new) } {set ret 0}} else {set ret 0}
  153. set err [Msg def txCfg IntFormatErr "Integer format '%f'" "%f=$format"]}
  154. "r" -
  155. "real" {set ret [regexp -nocase {^[-+]?([0-9]+\.?[0-9]*|[0-9]*\.?[0-9]+)(e[-+]?[0-9]+)?$} $new]
  156. if $ret {lset -create $format dummy lo hi
  157. if { ($lo!="") && ($lo>$new) } {set ret 0}
  158. if { ($hi!="") && ($hi<$new) } {set ret 0}} else {set ret 0}
  159. set err [Msg def txCfg RealFormatErr "Real format '%f'" "%f=$format"]}
  160. "o" -
  161. "option" {set ret 1
  162. if { [lsearch -exact [lrange $format 1 end] $new]<0 } {set ret 0
  163. set err [Msg def txCfg OptionFormatErr "Option format '%f'" "%f=$format"]}}
  164. "color" {set ret [regexp -nocase {(^#[0-9a-fA-F]+$)|(^[A-Za-z]+$)} $new]
  165. set err [Msg def txCfg ColorFormatErr "Color format '%f'" "%f=$format"]}
  166. "font" {set ret [regexp -nocase {^-[^-]+-[^-]+-[^-]+-.*$} $new]
  167. set err [Msg def txCfg FontFormatErr "Font format '%f'" "%f=$format"]}
  168. "dir" {if { ![file isdirectory $new] } {set err [Msg def txCfg DirFormatErr "This is not a valid directory name or the directory does not exist."]
  169. set ret 0} else {set ret 1}}
  170. default {set ret 0
  171. set err [Msg def txCfg NoFormatErr "The format '%f' is new to me, add it in widget.tcl" "%f=$format"]}}
  172. if { $ret!=1 } {Require txError 1
  173. upvar \#0 $w data 
  174. ErrorReport $data(w:current) [Msg def txCfg InputErrorHdr "Invalid Input"] [Msg def txCfg InputError "The value entered (%v) is not allowed for '%n'. Please read the documentation for more information about legal values.\n%e" %v=$new %n=[$data(w:name) get] %e=$err ]
  175. return 0}
  176. return 1}
  177. proc txCfg::Edit { w what } {upvar \#0 $w data
  178. if { $data(group)=="" } {bell
  179. return 0}
  180. if { $what=="default" } {$data(w:current) set [$data(w:default) get]}
  181. if { ![$data(w:current) validate] } {return 0}
  182. if { $data(-editcmd)!="" } {$data(w:current) config -modified 0
  183. set cmd [Replace $data(-editcmd) [list %w=$w %e=$data(w:current) %g=$data(group) %i=$data(item) %G=[$data(w:hlist) info data $data(group)] %I=[$data(w:hlist) item cget $data(group).$data(item) 0 -text] %d=[$data(w:default) get] %t=[$data(w:current) get] %n=[$data(w:name) get] %m=$what %f=$data(format) %o=[$data(w:doc) get 1.0 end] ]]
  184. eval $cmd}
  185. return 1}
  186. proc txCfg::Do { what w } {upvar \#0 $w data
  187. if { $data(-$what)!="" } {set cmd [Replace $data(-$what) [list %w=$w %e=$data(w:current) %g=$data(group) %i=$data(item) %d=[$data(w:default) get] %t=[$data(w:current) get] %n=[$data(w:name) get] ]]
  188. eval $cmd} else {bell}}
  189. # RCS:    $Id: setup.tcl,v 1.1.1.1 1996/05/12 14:46:18 risc Exp $
  190. Cfg def CfgEdit UserDir "~/.SW" -doc "This is the pathname to a directory that contains the users setup files." -format dir
  191. proc ConfigEdit { } {global CFG
  192. Require msg 2
  193. set CFG(modified) 0
  194. set CFG(top) .conf
  195. if { [winfo exists $CFG(top)] } {wm deiconify $CFG(top)
  196. raise $CFG(top)
  197. return} 
  198. Require txDlgShell 5
  199. txDlgShell $CFG(top) -title [Msg def CfgEdit Title "Config Editor"] -icon [LocateImage pixmap [Msg def CfgEdit Icon ""]] -iconname [Msg def CfgEdit IconName "Config-Editor"] -closecommand "ConfigExitAction $CFG(top)"
  200. set f [$CFG(top) subwidget frame]
  201. txCfg $f.cfg -showcmd "ConfigShowOne %w {%G} {%I}" -editcmd "ConfigEditAction %w %m {%G} {%I} {%d} {%t} {%o} {%f}" -savecmd "ConfigSaveAction" -loadcmd "ConfigReloadAction %w" -exitcmd "ConfigExitAction $CFG(top)"
  202. pack $f.cfg -padx 5 -pady 5 -fill both -expand y
  203. $CFG(top) show
  204. Require bltbusy 1.9
  205. blt_busy hold $CFG(top)
  206. update
  207. catch {ConfigFillIn $f.cfg}
  208. blt_busy forget $CFG(top)}
  209. proc ConfigStart {} {global CFG
  210. global AppName
  211. try {set fname [Locate install $AppName.pkg]} {Require txError 1
  212. ErrorReport $CFG(top) [Msg def CfgEdit PkgErrHdr "File not found"] [Msg def CfgEdit PkgErrMsg "the package file for '%a' could not be located" "%a=$AppName" ]
  213. return}
  214. set CFG(LibList) {}
  215. ConfigRead $fname "ConfigDef"
  216. set req [join {Req uire} ""]
  217. foreach i $CFG(LibList) {catch {eval $req $i}}
  218. catch {set ud [Cfg get CfgEdit UserDir]
  219. ConfigRead $ud/$AppName.cfg "Cfg set"}}
  220. proc ConfigFillIn { w } {ConfigStart
  221. set cvars [Cfg groups * *]
  222. set c1 0
  223. foreach i [lsort $cvars] {$w addgroup $c1 "$i"
  224. set cc [Cfg info $i *]
  225. set c2 0
  226. foreach j [lsort $cc] {$w additem $c1 $c2  "$j"
  227. incr c2}
  228. $w hideitems $c1
  229. incr c1}}
  230. proc ConfigShowOne { w group item } {set orig {}
  231. set now {}
  232. set doc {}
  233. catch {set orig [Cfg getdef $group $item]}
  234. try {set now [Cfg getset $group $item]} {set now $orig}
  235. set doc [Cfg cget $group $item -doc]
  236. set format [Cfg cget $group $item -format]
  237. if { $format=="" } {set format "s"}
  238. $w showitem $group $item $orig $now $doc $format}
  239. proc ConfigEditAction { w what group item orig new doc format} {global CFG
  240. switch $what {change {Cfg set $group $item $new
  241. $w showitem $group $item $orig $new $doc $format}
  242. revert {set new [Cfg get $group $item]
  243. $w showitem $group $item $orig $new $doc $format}
  244. default {Cfg set $group $item [Cfg getdef $group $item]
  245. set new [Cfg get $group $item]
  246. $w showitem $group $item $orig $new $doc $format}}
  247. set CFG(modified) 1
  248. $w blink}
  249. proc ConfigSaveAction {} {global AppName
  250. Require tclx 7.5
  251. set ud [Cfg get CfgEdit UserDir]
  252. if { ![file isdirectory $ud] } {try {mkdir -path $ud} {Require txError 1
  253. ErrorReport $w [Msg def CfgEdit PkgDirHdr "directory not found"] [Msg def CfgEdit PkgDirMsg "Could not create config directory '%d':\n%e" "%f=$ud" "%e=$err" ]
  254. return}}
  255. try {set fp [open $ud/$AppName.cfg "w"]} {Require txError 1
  256. ErrorReport $w [Msg def CfgEdit PkgErrHdr "File not found"] [Msg def CfgEdit CfgXErrMsg "Could not write config file '%f' in '%d':\n%e" "%d=$ud" "%f=$AppName.cfg" "%e=$err" ]
  257. return}
  258. set date [clock format [clock seconds] -format "%Y/%m/%d-%H:%M"]
  259. puts $fp "; Config $date, [id user]"
  260. set cvars [Cfg groups * *]
  261. foreach group [lsort $cvars] {set chg 0
  262. set txt "\n\[$group\]\n"
  263. set cc [Cfg info $group *]
  264. foreach item [lsort $cc] {set now [Cfg get $group $item]
  265. try {set orig [Cfg getdef $group $item]
  266. if { $now!=$orig } {append txt "$item=$now\n"
  267. set chg 1}} {append txt "$item=$now\n"
  268. set chg 1}}
  269. if { $chg } {puts -nonewline $fp $txt}}
  270. puts $fp "\n; EOF";
  271. close $fp
  272. global CFG
  273. set CFG(modified) 0}
  274. proc ConfigReloadAction { w } {global AppName
  275. set cvars [Cfg groups * *]
  276. foreach group $cvars {set cc [Cfg info $group *]
  277. foreach item $cc {catch {set orig [Cfg getdef $group $item]}
  278. try {set now [Cfg getset $group $item]} {continue}
  279. if { $now!=$orig } {Cfg set $group $item $orig}}}
  280. try {set ud [Cfg get CfgEdit UserDir]
  281. ConfigRead $ud/$AppName.cfg "Cfg set"} {Require txError 1
  282. ErrorReport $w [Msg def CfgEdit PkgErrHdr "File not found"] [Msg def CfgEdit CfgFileErrMsg "Could not read config file '%f':\n%e" "%f=$AppName.cfg" "%e=$err" ]}
  283. $w clearitem}
  284. proc ConfigExitAction { w} {global CFG
  285. if { $CFG(modified) } {set ret [AskReport $CFG(top) [Msg def CfgEdit AskSaveHdr "Save Settings"] [Msg def CfgEdit AskSaveMsg "You have made changes to the configuration settings. Click on 'Yes' to save them, 'No' will not save them but will keep the changes for the current session."] ]
  286. if { $ret==-1 } {return}
  287. if { $ret==1 } {ConfigSaveAction}}
  288. destroy $w
  289. unset CFG}
  290. proc ConfigDef { group args } {global CFG
  291. if { [regexp {^tlib-([^0-9]+)([0-9\.]+)} $group dummy name version]} {lappend CFG(LibList) [list $name $version]}}
  292. # +EOF
  293.